Data is taken from here from the “Travel Times” dataset for Boston. We want to look at how different transit policies impact the travel times within a city.

This research will first look at how travel times across Washington D.C. generally vary before and during the 2016 presidential election. We will then explore variations of this across different neighborhoods, income, and racial divides to examine bottlenecks in mobility for different identity groups. This research will contribute in explaining and interpreting variations in urban mobility during major events. It adds to the limited literature covering congestion capacity during agglomerating events such as the Olympics, natural disasters, and major holidays. It also aims to contribute by identifying heterogeneity across different socioeconomic barriers to better inform urban policy and planning aiming for equitable mobility.

Introduction

This paper explores mobility in Washington, D.C. during major events such as the 2017 women’s march and inauguration. On January 20, 2017, Donald Trump was inaugurated in Washington. The following day, January 21, was the women’s march and protest against the new president. The women’s march in Washington has been called the largest protest in the United States with an estimated 470,000 people in attendence (Wallace and Parlapiano 2017). Crowd scientists estimate that the crowd at the Trump inauguration was about a third of the size, making it around 160,000 people (Wallace and Parlapiano 2017). We also examined the impact of demographic census data on travel time during normal conditions in the same time of year and then during the event to observe how demographics impact mobility and how those factors are exacerbated during major shocks to the system. We found that the number of roads, distance to the Washington Monument, and the number of black residents are consistently the most significant predictors of travel time to the Washington Monument. Further, we found that ________ ADD FINDINGS ABOUT SIGNIFICANCE DURING SHOCK!!!

It is important to examine urban mobility in two ways. First, city attributes such as road or transit access make certain areas more accessible. Unfortunately, accessibility or mobility can often fall along racial or class lines. Washington is highly segregated and by using a spacial autoregressive model on travel time to the Washington Monument during normal times, we are able to see the impact of race on D.C. area mobility. We observed that the population of black residents in a census tract is one of few significant variables in predicting travel time to the Washington Monument. Second, major increases in population during special events can shock the city’s infrastructure. For this reason, we looked at Washington because it is a city that is especially significant during major national events such as the inauguration and attracts huge numbers of additional visitors. We used a similar spacial autoregressive model for the week of the inauguration and Women’s March and then modeled the differences between the normal weeks and the inauguration and march to observe the shock on the system. Through modeling both before and during the major events, we were able to observe both demographic significance of travel time and the impact of major population changes on the system.

In order to examine the shock from these massive events, we used areal Uber data which includes travel times between various census tract locations in the DC metropolitan area. To model travel times before and during the event periods, we isolated a location and looked only at the travel time between each census tract in the Washington metropolitan area and the Washington Monument. We chose the Washington Monument as the destination because it is in the middle of the National Mall where many significant events including the inauguration and women’s march took place. Because the shape files are census tracts, we were able to include census information for each polygon through the tidycensus package. This data allowed us to address the impact of demographics on travel time.

According to the New York Times, crowd scientists estimated 470,000 people were at the women’s march in Washington on January 21st, 2017. They say that the crowd at the women’s march was about three times the size of the crowd at the Trump inauguration, making the crowd roughly 160,000 people at the Trump inauguration. https://www.nytimes.com/interactive/2017/01/22/us/politics/womens-march-trump-crowd-estimates.html The 2010 data set of demographic information by census tracts comes from Urban Institute:

dc_acs_tracts$centroids <- st_centroid(st_geometry(dc_acs_tracts), of_largest_polygon)

plot(st_geometry(dc_acs_tracts), border="grey")
plot(dc_acs_tracts$centroids, add=TRUE, col="blue", cex = 0.3)

centroids <- data.frame(cbind(st_coordinates(st_centroid(dc_acs_tracts))))
## Warning in st_centroid.sf(dc_acs_tracts): st_centroid assumes attributes
## are constant over geometries of x
centroids <- centroids %>%
  mutate(GEOID = dc_acs_tracts$GEOID)

dc_acs_tracts <- left_join(x = dc_acs_tracts, y = centroids, by = "GEOID")

travel_time_sf <- left_join(x = travel_times_census_join, y = dc_acs_tracts, by = "GEOID") %>%
    st_as_sf() %>%
    st_transform(crs = 102285)
# Compute distance from Washington Monument
mnm <- tribble(
  ~latitude, ~longitude,
  38.8895, -77.0353
)

mnm_sf <- mnm %>%
  st_as_sf(coords = c("longitude", "latitude"), crs = 4326) %>%
  st_transform(crs = 102285)

travel_time_sf <- travel_time_sf %>%
  mutate(distance = st_distance(centroids, mnm_sf$geometry, by_element = TRUE),
             march_inaug = ifelse((year == 2017 & month == 1 & week %in% c(3, 4)), 1, 0))
map_lims <- st_bbox(dc_acs_tracts)

travel_time_sf %>% filter(year == 2017, month == 1, week == 3) %>%
    ggplot() +
    geom_sf(mapping = aes(fill = mean_travel_time), lwd=0.2) +
    geom_sf(data = travel_time_sf$centroids, cex = 0.5) +
    scale_fill_viridis_c(direction = -1)

travel_time_sf %>% filter(year == 2017, month == 1, week == 4) %>%
    ggplot() +
    geom_sf(mapping = aes(fill = mean_travel_time), lwd=0.2) +
    geom_sf(data = dc_roads, color = "white", lwd=0.2) +
    geom_sf(data = metro_line, color = "black", lwd=0.2) +
    theme_map +
  coord_sf(xlim = c(map_lims["xmin"], map_lims["xmax"]), ylim = c(map_lims["ymin"], map_lims["ymax"])) +
    scale_fill_viridis_c(direction = -1)

travel_time_sf %>% filter(year == 2017, month == 1, week == 3) %>%
    ggplot() +
    geom_sf(mapping = aes(fill = med_incomeE)) +
    theme_map +
    scale_fill_viridis_c()

travel_time_sf %>% filter(year == 2017, month == 1, week == 3) %>%
    ggplot() +
    geom_sf(mapping = aes(fill = blackE)) +
    theme_map +
    scale_fill_viridis_c()

travel_time_sf %>% filter(year == 2017, month == 1, week == 3) %>%
    ggplot() +
    geom_sf(mapping = aes(fill = car_transitE)) +
    theme_map +
    scale_fill_viridis_c()

Modeling

travel_time_sf$NumRoads <- sapply(st_intersects(travel_time_sf,dc_roads),length)
travel_time_sf$NumMetro <- sapply(st_intersects(travel_time_sf,metro_line),length)

# Average travel times over weeks 1 and 2 in January (before inauguration)
weeks12 <- travel_time_sf %>%
  filter(year %in% 2017) %>%
  filter(month %in% 1) %>%
  filter(week %in% 1:2) %>%
  select(GEOID,mean_travel_time) %>%
  as.data.frame() %>%
  group_by(GEOID) %>%
  summarize(MeanTimeNorm = mean(mean_travel_time))

weeks12_data <- travel_time_sf %>%
  filter(year %in% 2017) %>%
  filter(month %in% 1) %>%
  filter(week %in% c(1:2)) %>%
  distinct(GEOID, .keep_all = TRUE) %>%
  dplyr::select(GEOID, starts_with('med_'), starts_with('white'), starts_with('asian'), starts_with('black'), starts_with('car_trans'), starts_with('public_trans'), NumRoads, NumMetro, distance) %>%
  left_join(weeks12, by = 'GEOID')

# Average travel times over weeks 3 and 4 in January (during & after inauguration)
weeks34 <- travel_time_sf %>%
  filter(year %in% 2017) %>%
  filter(month %in% 1) %>%
  filter(week %in% 3:4) %>%
  select(GEOID,mean_travel_time) %>%
  as.data.frame() %>%
  group_by(GEOID) %>%
  summarize(MeanTimeIng = mean(mean_travel_time))

weeks34_data <- travel_time_sf %>%
  filter(year %in% 2017) %>%
  filter(month %in% 1) %>%
  filter(week %in% c(3:4)) %>%
  distinct(GEOID, .keep_all = TRUE) %>%
  dplyr::select(GEOID, starts_with('med_'), starts_with('white'), starts_with('asian'), starts_with('black'), starts_with('car_trans'), starts_with('public_trans'), NumRoads, NumMetro, distance) %>%
  left_join(weeks34, by = 'GEOID')

# Take difference in average travel times before and after inauguration
weeksdiff <- left_join(weeks12, weeks34) %>%
  mutate(diffMeanTime = MeanTimeIng - MeanTimeNorm)
## Joining, by = "GEOID"
weeksdiff_data <- travel_time_sf %>%
  filter(year %in% 2017) %>%
  filter(month %in% 1) %>%
  filter(week %in% 1) %>%
  dplyr::select(GEOID, med_incomeE, med_incomeM, asianE, asianM, blackE, blackM, public_transitE, public_transitM, car_transitE, car_transitM, NumRoads, NumMetro, distance) %>%
  left_join(weeksdiff, by = 'GEOID')

Normal Mean Time Model

st_queen <- function(a, b = a) st_relate(a, b, pattern = "F***T****")
as.nb.sgbp <- function(x, ...) {
  attrs <- attributes(x)
  x <- lapply(x, function(i) { if(length(i) == 0L) 0L else i } )
  attributes(x) <- attrs
  class(x) <- "nb"
  x
}
queen12 <- as.nb.sgbp(st_queen(weeks12_data))
W <- nb2mat(queen12, style='B', zero.policy = TRUE)
listW <- nb2listw(queen12)

dc_sar_12 <- spautolm(formula = MeanTimeNorm ~ med_incomeE + med_incomeM + asianE + asianM + blackE + blackM + public_transitE + public_transitM + car_transitE + car_transitM + NumRoads + NumMetro + distance, data = weeks12_data, listw = listW, family = "SAR")

summary(dc_sar_12)
## 
## Call: spautolm(formula = MeanTimeNorm ~ med_incomeE + med_incomeM + 
##     asianE + asianM + blackE + blackM + public_transitE + public_transitM + 
##     car_transitE + car_transitM + NumRoads + NumMetro + distance, 
##     data = weeks12_data, listw = listW, family = "SAR")
## 
## Residuals:
##        Min         1Q     Median         3Q        Max 
## -345.76964  -66.61612    0.92572   63.60008  405.12768 
## 
## Coefficients: 
##                    Estimate  Std. Error z value  Pr(>|z|)
## (Intercept)      1.0831e+03  1.5961e+02  6.7863 1.150e-11
## med_incomeE     -4.7538e-04  1.8551e-04 -2.5626  0.010388
## med_incomeM      1.7767e-03  6.4201e-04  2.7674  0.005651
## asianE          -2.8622e-02  2.8789e-02 -0.9942  0.320119
## asianM           3.1822e-02  8.6564e-02  0.3676  0.713166
## blackE           2.2607e-02  8.9937e-03  2.5137  0.011947
## blackM          -1.1687e-01  5.7145e-02 -2.0451  0.040847
## public_transitE  1.9083e-02  2.7433e-02  0.6956  0.486668
## public_transitM -8.3911e-02  1.3531e-01 -0.6201  0.535165
## car_transitE     1.0447e-02  1.5743e-02  0.6636  0.506960
## car_transitM    -9.8756e-02  9.3609e-02 -1.0550  0.291435
## NumRoads        -6.9817e+00  1.1923e+00 -5.8556 4.753e-09
## NumMetro        -2.0462e+01  7.6550e+00 -2.6730  0.007517
## distance         2.0975e-02  6.7847e-03  3.0914  0.001992
## 
## Lambda: 0.96863 LR test value: 989.99 p-value: < 2.22e-16 
## Numerical Hessian standard error of lambda: 0.010293 
## 
## Log likelihood: -3373.246 
## ML residual variance (sigma squared): 10677, (sigma: 103.33)
## Number of observations: 543 
## Number of parameters estimated: 16 
## AIC: 6778.5
# plot(weeks12["mean_travel_time"])
# plot(queen12, weeks12$centroids, col="blue", cex = 0.5, lwd = 0.5)
queen34 <- as.nb.sgbp(st_queen(weeks34_data))
W <- nb2mat(queen34, style='B', zero.policy = TRUE)
listW <- nb2listw(queen34)

dc_sar_34 <- spautolm(formula = MeanTimeIng ~ med_incomeE + med_incomeM + asianE + asianM + blackE + blackM + public_transitE + public_transitM + car_transitE + car_transitM + NumRoads + NumMetro + distance, data = weeks34_data, listw = listW, family = "SAR")

summary(dc_sar_34)
## 
## Call: spautolm(formula = MeanTimeIng ~ med_incomeE + med_incomeM + 
##     asianE + asianM + blackE + blackM + public_transitE + public_transitM + 
##     car_transitE + car_transitM + NumRoads + NumMetro + distance, 
##     data = weeks34_data, listw = listW, family = "SAR")
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -384.5352  -69.9064    2.0265   70.2418  393.8877 
## 
## Coefficients: 
##                    Estimate  Std. Error z value  Pr(>|z|)
## (Intercept)      1.0859e+03  1.5044e+02  7.2186 5.254e-13
## med_incomeE     -4.5296e-04  1.9116e-04 -2.3695  0.017813
## med_incomeM      1.5318e-03  6.6156e-04  2.3154  0.020589
## asianE          -4.5941e-02  2.9666e-02 -1.5486  0.121477
## asianM           7.1844e-02  8.9211e-02  0.8053  0.420634
## blackE           2.7638e-02  9.2662e-03  2.9827  0.002857
## blackM          -1.3682e-01  5.8901e-02 -2.3229  0.020184
## public_transitE  9.9672e-03  2.8267e-02  0.3526  0.724382
## public_transitM -3.7404e-02  1.3943e-01 -0.2683  0.788488
## car_transitE     5.7002e-03  1.6229e-02  0.3512  0.725407
## car_transitM    -8.6745e-02  9.6463e-02 -0.8993  0.368517
## NumRoads        -6.7050e+00  1.2284e+00 -5.4582 4.810e-08
## NumMetro        -2.1325e+01  7.8862e+00 -2.7040  0.006850
## distance         2.1432e-02  6.9079e-03  3.1025  0.001919
## 
## Lambda: 0.96501 LR test value: 979.66 p-value: < 2.22e-16 
## Numerical Hessian standard error of lambda: 0.010737 
## 
## Log likelihood: -3393.998 
## ML residual variance (sigma squared): 11330, (sigma: 106.44)
## Number of observations: 544 
## Number of parameters estimated: 16 
## AIC: 6820
# plot(weeks34["mean_travel_time"])
# plot(queen34, weeks34$centroids, col="blue", cex = 0.5, lwd = 0.5)

Difference Model

queen_diff <- as.nb.sgbp(st_queen(weeksdiff_data))
W <- nb2mat(queen_diff, style='B', zero.policy = TRUE)
listW <- nb2listw(queen_diff)

dc_sar_diff <- spautolm(formula = diffMeanTime ~ med_incomeE + med_incomeM + asianE + asianM + blackE + blackM + public_transitE + public_transitM + car_transitE + car_transitM + NumRoads + NumMetro + distance, data = weeksdiff_data, listw = listW, family = "SAR")

summary(dc_sar_diff)
## 
## Call: spautolm(formula = diffMeanTime ~ med_incomeE + med_incomeM + 
##     asianE + asianM + blackE + blackM + public_transitE + public_transitM + 
##     car_transitE + car_transitM + NumRoads + NumMetro + distance, 
##     data = weeksdiff_data, listw = listW, family = "SAR")
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -368.7223  -14.0757   -1.5434   14.7713  286.6781 
## 
## Coefficients: 
##                    Estimate  Std. Error z value  Pr(>|z|)
## (Intercept)      4.8990e+01  1.4722e+01  3.3276 0.0008758
## med_incomeE     -3.1150e-06  7.7097e-05 -0.0404 0.9677714
## med_incomeM     -1.5106e-04  2.8573e-04 -0.5287 0.5970222
## asianE          -2.0151e-02  1.1958e-02 -1.6852 0.0919438
## asianM           3.1413e-02  3.7841e-02  0.8301 0.4064620
## blackE           3.5201e-03  3.5790e-03  0.9836 0.3253298
## blackM          -1.9259e-02  2.4939e-02 -0.7723 0.4399650
## public_transitE -4.9272e-03  1.1817e-02 -0.4169 0.6767172
## public_transitM  4.2836e-02  6.0303e-02  0.7103 0.4774927
## car_transitE    -3.0538e-03  6.6778e-03 -0.4573 0.6474494
## car_transitM     8.1589e-03  4.1356e-02  0.1973 0.8436038
## NumRoads         3.8565e-01  4.8685e-01  0.7921 0.4282791
## NumMetro         8.2421e-03  3.1666e+00  0.0026 0.9979233
## distance        -1.3050e-03  1.0770e-03 -1.2117 0.2256175
## 
## Lambda: 0.61443 LR test value: 119.19 p-value: < 2.22e-16 
## Numerical Hessian standard error of lambda: 0.046445 
## 
## Log likelihood: -2844.895 
## ML residual variance (sigma squared): 1918.1, (sigma: 43.797)
## Number of observations: 543 
## Number of parameters estimated: 16 
## AIC: 5721.8
travel_time_sf_nontreat <- travel_time_sf %>%
    filter(march_inaug == 0) %>%
    group_by(GEOID) %>%
    summarise(mtt_mean = mean(mean_travel_time),
                        mtt_var = var(mean_travel_time),
                        mtt_sd = sd(mean_travel_time),
                        NumRoads = log(mean(NumRoads) + 0.0001),
                        NumMetro = log(mean(NumMetro + 0.0001)))
travel_time_sf_nontreat %>%
    ggplot() +
    geom_sf(mapping = aes(fill = mtt_mean)) +
    theme_map +
    scale_fill_viridis_c()

travel_time_sf_nontreat %>%
    ggplot() +
    geom_sf(mapping = aes(fill = mtt_sd)) +
    theme_map +
    scale_fill_viridis_c()

travel_time_sf_nontreat %>%
    ggplot() +
    geom_sf(mapping = aes(fill = NumRoads)) +
    theme_map +
    scale_fill_viridis_c()

travel_time_sf_nontreat %>%
    ggplot() +
    geom_sf(mapping = aes(fill = NumMetro)) +
    theme_map +
    scale_fill_viridis_c()

Wallace, Tim, and Alicia Parlapiano. 2017. “Crowd Scientists Say Women’s March in Washington Had 3 Times as Many People as Trump’s Inauguration.” The New York Times. The New York Times. https://www.nytimes.com/interactive/2017/01/22/us/politics/womens-march-trump-crowd-estimates.html?searchResultPosition=1.